home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Visual Basic Source Code
/
Visual Basic Source Code.iso
/
vbsource
/
vbpdem
/
cancprt.frm
< prev
next >
Wrap
Text File
|
1995-12-05
|
5KB
|
173 lines
VERSION 2.00
Begin Form PrinterACTION
BackColor = &H00FFFFFF&
BorderStyle = 1 'Fixed Single
Caption = "Printer ACTION"
ClientHeight = 1965
ClientLeft = 2550
ClientTop = 2760
ClientWidth = 4050
Height = 2370
Left = 2490
LinkMode = 1 'Source
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 1965
ScaleWidth = 4050
Top = 2415
Width = 4170
Begin CommandButton CancelButton
Caption = "Cancel"
Height = 375
Left = 2280
TabIndex = 1
Top = 1440
Width = 1455
End
Begin PictureBox Picture1
BackColor = &H00FFFFFF&
BorderStyle = 0 'None
Height = 735
Left = 120
Picture = CANCPRT.FRX:0000
ScaleHeight = 735
ScaleWidth = 615
TabIndex = 0
Top = 240
Width = 615
End
Begin Label PageNumber
ForeColor = &H00FF0000&
Height = 375
Left = 240
TabIndex = 4
Top = 1440
Width = 1935
End
Begin Label DocumetName
Alignment = 2 'Center
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 9.75
FontStrikethru = 0 'False
FontUnderline = 0 'False
ForeColor = &H000000FF&
Height = 375
Left = 960
TabIndex = 3
Top = 840
Width = 3015
End
Begin Label PrinterHEADER
Alignment = 2 'Center
BackColor = &H00FFFFFF&
Caption = "Printing in Progress"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 12
FontStrikethru = 0 'False
FontUnderline = 0 'False
ForeColor = &H000000FF&
Height = 615
Left = 840
TabIndex = 2
Top = 120
Width = 3135
End
End
Sub CancelButton_Click ()
pABORT = True
Beep
End Sub
Sub Command1_Click ()
pABORT = True
End Sub
Sub Form_Load ()
' Please note this DEMO only allows printing of TEXT Documents in the
' Current default sub-directory...
' This routine will print a file to the DEFAULT printer
' Allowing the user to CANCEL the job. The routine also offers
' proper page breaks to occur in the output.
Dim PrintLine As String, HeaderLine As String
Dim PageSize As Integer, LineSpace As Integer, LinesPerPage As Integer
Dim LineLength As Integer, CurrentLine As Integer
Dim PageInfo As TextMetric
printerACTION.Show
DocumetName.Caption = UCase$(DocName)
printerACTION.Refresh
pABORT = False ' Set ABORT flag to FALSE
screen.mousepointer = NORMAL
code = GetTextMetrics(Printer.hdc, PageInfo) ' Get Printer Page Information
' Calc the available space
LineSpace = PageInfo.tmHeight + PageInfo.tmExternalLeading
PageSize = GetDeviceCaps(Printer.hdc, VERTRES)
LinesPerPage = Int(PageSize / (LineSpace - 1)) - 1
HeaderLine = " Print Routine Ver 1.0 EJO Page: "
' Open the TEXT File to print
Open DocName For Input As #1
CurrentLine = 3
printerACTION.PageNumber.Caption = "Printing Page : 1"
printerACTION.Refresh
Printer.Print HeaderLine + "1" + Chr$(13) + Chr$(10)
Do While Not EOF(1) And DoEvents()
' Allow the User to ABORT
code = SetActiveWindow(printerACTION.hdc)
Line Input #1, PrintLine
Printer.Print PrintLine
CurrentLine = CurrentLine + 1 ' increment the Current Line counter
If CurrentLine > LinesPerPage Then
CurrentLine = 3
If pABORT = True Then ' Printing is ABORTED
printerACTION.PrinterHEADER.Caption = "Printing has been ABORTED"
printerACTION.Refresh
delay_it (5) ' Allow message to be read
Exit Do
Else
Printer.NewPage
printerACTION.PageNumber.Caption = "Printing Page : " + Str$(Printer.page)
printerACTION.Refresh
' Any Headers Should be Printed Here
Printer.Print HeaderLine + LTrim$(Str$(Printer.page)) + Chr$(13) + Chr$(10)
End If
End If
Loop
' Housekeeping for end of Print JOB
Printer.NewPage
Printer.EndDoc ' END of the Printing job
Close #1
End Sub